home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The 640 MEG Shareware Studio 2
/
The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO
/
pascal
/
tpb4_src.zip
/
LOGINOUT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-09-13
|
14KB
|
467 lines
{ TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen
Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault
Last modified :: 8-28-88 5:02 pm
}
{$R-} {Range checking off}
{$B-} {Boolean complete evaluation off}
{$S-} {Stack checking off}
{$I+} {I/O checking on}
{$N-} {No numeric coprocessor}
Unit Loginout;
Interface
Uses
TPCrt, Dos, Globals, TPSTRING, TPDOS,
TAccess, Core1, Core2, Utilmnu2;
procedure login;
procedure wrapup;
procedure check_300_restrict;
{==========================================================================}
Implementation
procedure login;
var
continue,
abort : Boolean;
key : StrName;
procedure get_new_user(var continue : Boolean);
var
i : Integer;
begin
continue := False;
WriteLn(Com);
WriteLn(Com, 'Name not found.');
list('A');
WriteLn(Com);
continue := ask('Are you a new user', 'N');
if continue then
with user_rec do
begin
cy := '';
ph := '';
FillChar(last_read, 128, 0);
get_nulls;
repeat
st := prompt('From what STATE [2 letter abbrev.] are you calling', len_st, 'ES')
until (Length(st) = 2) or (not Online);
repeat
cy := prompt('What CITY', len_ad, 'ESL')
until (Length(cy) > 1) or (not Online);
for i := 2 to Length(cy) do
if (cy[i] in ['A'..'Z']) then
if cy[Pred(i)] <> Chr($20) then
cy[i] := Chr(Ord(cy[i])+32);
get_phone;
repeat
ad := prompt('What type of computer do you use ', len_ad, 'ESL');
until (Length(ad) > 1) or (not online);
get_case;
WriteLn(Com);
WriteLn(Com, ' Name: ', fn, ' ', ln);
WriteLn(Com, ' Phone: ', ph);
WriteLn(Com, ' City: ', cy, ', ', st, '.');
WriteLn(Com, 'System: ', ad);
WriteLn(Com);
continue := online and (ask('Is this correct', 'Y'));
if continue then
begin
get_new_password;
get_protocol;
pause;
WriteLn(Com);
continue := online;
used := 0;
if fn = 'SYSOP' then
access := 255
else
access := uval_acc;
limit := uval_time;
if fn = 'SYSOP' then
conf_flags := 254
else
conf_flags := 0;
columns := def_chars;
lines := def_lines;
for i := 0 to 5 do
laston[i] := 0;
time_today := 0;
Flags := 0;
if (not down_ok) then
set_bit(Flags, 1);
time_total := 0;
lasthi := 0;
if CreditType = Files then
upload := 0
else
upload := UpCredit;
download := 0;
acct_bal := 0;
caca := 0;
ratio := up_down_ratio;
key := pad(ln, len_ln)+pad(fn, len_fn);
if continue then
begin
AddRec(DatF, user_loc, user_rec);
AddKey(IdxF, user_loc, key);
FlushFile(DatF);
FlushIndex(IdxF);
end;
log(9, '');
list('I');
pause
end
end
end;
procedure init_user;
procedure display_random_quote; {vdp 4/18/87. inserted procedure}
var
sel : Integer;
begin {procedure display_random_quote}
if quot_count > 0 then
begin
sel := Random(quot_count);
Seek(qidx_file, sel);
Read(qidx_file, qidx_rec);
Seek(quot_file, qidx_rec.loc);
quot_rec.Text := 'ZZZ';
WriteLn(Com);
while (not EoF(quot_file)) and (quot_rec.Text <> '') and Online do
begin
Read(quot_file, quot_rec);
WriteLn(Com, quot_rec.Text);
end;
end;
end; {procedure display_random_quote}
begin {init_user}
temp_hi_lmr := user_rec.lasthi;
TempLastRead := user_rec.last_read;
if local_online then
log(2, 'Local')
else
log(2, intstr(rate, 3)+' bps');
Seek(logr_file, 0);
Read(logr_file, logr_rec);
if (logr_rec.user < 65535) and (user_rec.fn <> 'SYSOP') then
Inc(logr_rec.user)
else
if logr_rec.user >= 65535 then logr_rec.user := 1;
Seek(logr_file, 0);
Write(logr_file, logr_rec);
FlushAny(logr_file);
GetTAD(login_t);
if (login_t[3] <> user_rec.laston[3]) or (login_t[4] <> user_rec.laston[4]) or
(login_t[5] <> user_rec.laston[5]) then
user_rec.time_today := 0;
first_scan := True;
if user_rec.access < 10 { Hang up on twit }
then
remote_online := False
else
begin
if (not(user_rec.protocol in ['X', 'C', 'Y', 'B', 'Z', 'G', 'Q', 'O']))
then get_protocol;
show_user_stats;
display_random_quote;
end;
end;
procedure get_name(var fn : FirstName; var ln : LastName; mode : Char);
{ Get user name }
var
try,
try_name : Integer;
work : StrStd;
test_names,
found, OK : Boolean;
namesfile : Text;
begin
WriteLn(Com);
try := 0;
try_name := 0;
test_names := True;
found := False;
if mode = 'C' then
begin
Assign(namesfile, 'BADNAMES.LST');
{$I-}
Reset(namesfile); {$I+}
if IoResult <> 0 then
test_names := False; {file doesn't exist}
end
else
test_names := False;
repeat
repeat
fn := trim(prompt('FIRST name', len_fn, 'ESN'));
Inc(try);
until (not Online) or (fn <> '') or (try > max_tries);
if try > max_tries then
begin
remote_online := False;
mdhangup;
end;
if fn = 'SYSOP' then
ln := ''
else
begin
try := 0;
repeat
ln := trim(prompt(' LAST name', len_ln, 'ESN'));
Inc(try);
until (not Online) or (ln <> '') or (try > max_tries);
if try > max_tries then
begin
remote_online := False;
mdhangup;
end;
end;
if (try < max_tries) and (mode = 'C') and (Online) and (test_names) then
begin
Reset(namesfile);
while (not EoF(namesfile)) and (Online) and (test_names) and (not found) do
begin
ReadLn(namesfile, work);
if (Pos(work, fn) <> 0) or (Pos(work, ln) <> 0) then
found := True;
end;
if found then
begin
WriteLn(Com, 'That name is reserved...try again');
Log(19, 'Name');
Inc(try_name);
found := False;
end
else
test_names := False;
end;
if try_name > max_tries then
begin
remote_online := False;
mdhangup;
end;
until (not Online) or (try > max_tries) or (try_name > max_tries) or (not test_names);
if (mode = 'C') then
begin
{$I-}
Close(namesfile);
OK := (IoResult = 0);
{$I+}
end;
end;
begin { login }
abort := False;
if not cmd_tail then
begin
Delay(1000);
if Ch_Inprdy then
begin
Delay(5000);
repeat
Delay(9);
Clear_inbuf;
until not Ch_Inprdy;
end;
end;
GoToXY(1, 23);
WriteLn(Com);
WriteLn(Com, version);
WriteLn(Com, ver_date);
repeat
until (not brk) or (not Online);
if (not macro_in_progress) and (Online) then
begin
WriteLn(Com);
WriteLn(Com);
if ask(question, 'N') then
graphics_on
else
graphics_off
end;
if (not macro_in_progress) and (Online) then
list('W');
repeat
if macro_in_progress then
begin
user_rec.fn := 'SYSOP';
user_rec.ln := '';
graphics_on;
end
else
get_name(user_rec.fn, user_rec.ln, 'C');
timeout := sleepy_time; { increase input timeout }
if user_rec.fn = 'SYSOP' then
UserFullName := fido_sysop
else UserFullName := user_rec.fn+' '+user_rec.ln;
{$V-}
caps_to_mixed(UserFullName) {$V+} ;
UserFirstName := StLocase(user_rec.fn);
UserFirstName[1] := Upcase(UserFirstName[1]);
key := pad(user_rec.ln, len_ln)+pad(user_rec.fn, len_fn);
FindKey(IdxF, user_loc, key);
if OK then
begin
GetRec(DatF, user_loc, user_rec);
if macro_in_progress then
begin
valid_pw := True;
mode := sysop_mode;
end
else
begin
get_old_password(' Password', valid_pw);
if not valid_pw then
list('P');
end;
continue := True;
end
else
begin
if (diskfree(Ord(Upcase(HomDrv[1]))-64) div 1024) > maxfree_logs then
begin
get_new_user(continue);
if continue then
valid_pw := True;
end
else
begin
valid_pw := False;
WriteLn(Com);
WriteLn(Com, 'Name not found. Not enough disk space for new callers.');
WriteLn(Com, ' Please call back soon.');
WriteLn(Com);
Delay(5000);
continue := False;
remote_online := False;
mdhangup;
abort := True;
end;
end;
until (not Online) or continue or abort;
in_use := valid_pw;
connected := continue;
if Online and in_use then
init_user;
end;
procedure wrapup;
{ Disconnect, update and close all files}
var
i, J, time_on,
time_left : Integer;
t : tad_array;
begin
SetSect(HomName);
WriteLn(Com);
Write(Com, 'Hope you enjoyed your visit, ', UserFirstName, '. Call again soon...');
WriteLn(Com);
Delay((9600 div rate)*100);
if valid_pw { Don't update files if user not initialized }
then
begin
GetTAD(t);
timer(time_on, time_left);
time_on := time_on-extra_time;
if (login_t[3] = t[3]) and (user_rec.access < 250) then
user_rec.time_today := user_rec.time_today+time_on
else
user_rec.time_today := 0;
user_rec.time_total := user_rec.time_total+time_on;
user_rec.laston := t;
if temp_hi_lmr > user_rec.lasthi then
user_rec.lasthi := temp_hi_lmr;
user_rec.last_read := TempLastRead;
PutRec(DatF, user_loc, user_rec);
log(3, ' ');
i := login_t[1];
J := login_t[2];
while J <> t[2] do
begin
stat_rec.busy_per_hour[J] := stat_rec.busy_per_hour[J]+60-i;
i := 0;
J := Succ(J) mod 24
end;
stat_rec.busy_per_hour[J] := stat_rec.busy_per_hour[J]+t[1]-i;
Assign(stat_file, stat_name+ext);
Reset(stat_file);
Write(stat_file, stat_rec);
Close(stat_file)
end;
CloseFile(DatF);
CloseIndex(IdxF);
CloseIndex(NewinArea);
CloseIndex(NewinName);
Close(logr_file);
Close(nwin_file);
Close(summ_file);
Close(mesg_file);
if macro_file_exists then
begin
Close(macro_file);
macro_file_exists := False;
end;
if (mode = sysop_mode) and (local_online) and (ch = 'Q') then
Halt;
mdhangup;
end;
procedure check_300_restrict;
var
t : tad_array;
begin
GetTAD(t);
if (rate = 300) and (restrict300) and (t[2] > start_restrict300) and
(t[2] < end_restrict300) and (not local_online) then
begin
WriteLn(Com);
WriteLn(Com, '300 Baud Callers are restricted from ', start_restrict300, ':00 - ',
end_restrict300,
':00 hours.');
WriteLn(Com, 'Please call back outside of these times.');
Delay((9600 div rate)*200);
remote_online := False;
mdhangup;
end;
end;
end. { of LOGINOUT.PAS }